home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Amiga Public Domain Connection / APDC Disk #025 - Programming Languages (198x)(Amiga Public Domain Connection)(US)[m][WB].zip / APDC Disk #025 - Programming Languages (198x)(Amiga Public Domain Connection)(US)[m][WB].adf / Modula-2 / m2 / date.MOD < prev    next >
Text File  |  1988-03-15  |  3KB  |  113 lines
  1. (********************************************************************************
  2.  
  3. Name         : date.MOD
  4. Version      : 1.0
  5. Purpose      : Date Conversion
  6. Author       : ms
  7. Modified     : 13.3.86  21:10  ms
  8.  
  9. ********************************************************************************)
  10.  
  11. MODULE date;
  12.  
  13. FROM Terminal   IMPORT BusyRead, Write, WriteLn, WriteString;
  14. FROM AMIGADos   IMPORT AMIGADateStamp, DateStamp, Delay;
  15. FROM Breaks     IMPORT BreakFlags, DetectBreak;
  16.  
  17. (* By the way, this routine will fail on March 1, 2100. *)
  18.  
  19. VAR b: ARRAY [0..99] OF CHAR;
  20.     j: CARDINAL;
  21.  
  22. PROCEDURE Put(s: CHAR);
  23. BEGIN
  24.   b[j]:=s; INC(j)
  25. END Put;  
  26.  
  27. PROCEDURE PutS(s: ARRAY OF CHAR);
  28.   VAR i: CARDINAL;
  29. BEGIN
  30.   i:=0;
  31.   WHILE (i<=HIGH(s)) DO
  32.     b[j]:=s[i]; INC(i); INC(j)
  33.   END
  34. END PutS;  
  35.  
  36. PROCEDURE WriteInt(int, size: INTEGER; leadingZeros: BOOLEAN);
  37. CONST stLen = 9;
  38. VAR   s: ARRAY [0..stLen] OF CHAR;
  39.       i: INTEGER;
  40.       minus: BOOLEAN;
  41.       fillchar: CHAR;
  42. BEGIN
  43.   IF leadingZeros THEN fillchar:='0' ELSE fillchar:=' ' END;
  44.   i:=stLen;
  45.   minus:=int<0;
  46.   int:=ABS(int);
  47.   REPEAT
  48.     s[i]:=CHR(ORD('0')+ORD(int MOD 10)); int:=int DIV 10; DEC(i)
  49.   UNTIL int=0;
  50.   IF minus THEN
  51.     s[i]:='-'; DEC(i)
  52.   END;
  53.   WHILE size>stLen-i DO
  54.     Put(fillchar); DEC(size)
  55.   END;
  56.   REPEAT
  57.     INC(i); Put(s[i])
  58.   UNTIL i=stLen;
  59. END WriteInt;
  60.  
  61. VAR v: AMIGADateStamp;
  62.     n, y, m, d: INTEGER;
  63.     ch: CHAR;
  64. BEGIN
  65.   Write(14C);
  66.   WriteString('Current Date and Time');
  67.   WriteLn; 
  68.   REPEAT
  69.     j:=0;
  70.     Put(' ');
  71.     DateStamp(v);
  72.     WITH v DO
  73.       n:=SHORT(days)-2251;
  74.       y:=(4*n+3) DIV 1461;
  75.       n:=n-1461*y DIV 4;
  76.       y:=y+1984;
  77.       m:=(5*n+2) DIV 153;
  78.       d:=n-(153*m+2) DIV 5 +1;
  79.       m:=m+3;
  80.       IF m>12 THEN y:=y+1 END;
  81.       WriteInt(d, 2, FALSE); Put(' ');
  82.       CASE m OF
  83.       | 1: PutS('January');
  84.       | 2: PutS('February');
  85.       | 3: PutS('March');
  86.       | 4: PutS('April');
  87.       | 5: PutS('May');
  88.       | 6: PutS('June');
  89.       | 7: PutS('July');
  90.       | 8: PutS('August');
  91.       | 9: PutS('September');
  92.       |10: PutS('October');
  93.       |11: PutS('November');
  94.       |12: PutS('December');
  95.       ELSE PutS('unknown');
  96.       END;
  97.       Put(' ');
  98.       WriteInt(y, 4, FALSE);
  99.       PutS('   ');
  100.       m:=SHORT(minutes);
  101.       WriteInt(m DIV 60, 2, FALSE);
  102.       Put(':');
  103.       WriteInt(m MOD 60, 2, TRUE);
  104.       Put(':');
  105.       WriteInt(SHORT(ticks) DIV 50, 2, TRUE);
  106.       Put(15C);
  107.       Put(0C);
  108.       WriteString(b);
  109.       Delay(25)
  110.     END;
  111.   UNTIL DetectBreak(breakC)
  112. END date.MOD
  113.